home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / adlibpas.zip / MUSICI.PAS < prev   
Pascal/Delphi Source File  |  1990-04-10  |  10KB  |  434 lines
  1. unit MusicIO;
  2. {Contains procedures and function to call to Ad-Lib sound Driver.
  3.  if Sound Driver is not Loaded the system WILL Crash.
  4.  Parameters must be passed backwards since the sound driver is made
  5.  for a C parameter passing sequence.}
  6.  
  7. interface
  8.  
  9.   uses
  10.     DOS;
  11.  
  12.   type
  13.     Instrument = array[1..26] of integer;
  14.  
  15.   var
  16.     GActVoice :word; {Active Voice}
  17.     GT        :array[0..10] of Instrument; {use global variable to keep array valid}
  18.  
  19.   procedure InitDriver;
  20.   procedure RelTimeStart(TimeNum,TimeDen :integer);
  21.   procedure SetState(State :integer);
  22.   function GetState :boolean;
  23.   procedure SetMode(PercussionMode :integer);
  24.   function SetVolume(VolNum,VolDen,TimeNum,TimeDen :integer) :boolean;
  25.   function SetTempo(Tempo,TimeNum,TimeDen :integer) :boolean;
  26.   procedure SetActVoice(Voice :word);
  27.   function PlayNote(Pitch :integer; LengthNum,LengthDen :word) :boolean;
  28.   function SetTimbre(TimeNum,TimeDen :word) :boolean;
  29.   procedure SetTickBeat(TickBeat :integer);
  30.   procedure DirectNoteOn(Voice :word; Pitch :integer);
  31.   procedure DirectNoteOff(Voice :word);
  32.   procedure DirectTimbre;
  33.   procedure LoadInstrument(FileSpec :string);
  34.   function LoadSong(FileSpec :string) :boolean;
  35.  
  36.  
  37. implementation
  38.  
  39.   {Returns True if file exists; otherwise, it returns False. Closes the file if it exists.}
  40.   function Exist(fs :string) :boolean;
  41.     var
  42.       f: file;
  43.     begin
  44.       {$I-}
  45.       Assign(f,fs);
  46.       Reset(f);
  47.       Close(f);
  48.       {$I+}
  49.       Exist:=(IOResult=0) and (fs<>'');
  50.     end;
  51.  
  52.  
  53.   procedure InitDriver;
  54.     {Initialize Sound Driver}
  55.     var
  56.       r :registers;
  57.     begin
  58.       r.SI:=0;
  59.  
  60.       Intr(101,r);
  61.     end;
  62.  
  63.   procedure RelTimeStart(TimeNum,TimeDen :integer);
  64.     {Set Relative Time to Start}
  65.     var
  66.       TD,TN :integer;
  67.       r :registers;
  68.     begin
  69.       TD:=TimeDen;
  70.       TN:=TimeNum;
  71.  
  72.       r.SI:=2;
  73.       r.ES:=Seg(TN);
  74.       r.BX:=Ofs(TN);
  75.  
  76.       Intr(101,r);
  77.     end;
  78.  
  79.   procedure SetState(State :integer);
  80.     {Start or Stop a Song}
  81.     var
  82.       r :registers;
  83.     begin
  84.       r.SI:=3;
  85.       r.ES:=Seg(State);
  86.       r.BX:=Ofs(State);
  87.  
  88.       Intr(101,r);
  89.     end;
  90.  
  91.   function GetState :boolean;
  92.     var
  93.       r :registers;
  94.     begin
  95.       r.SI:=4;
  96.       r.ES:=Seg(GetState);
  97.       r.BX:=Ofs(GetState);
  98.  
  99.       Intr(101,r);
  100.  
  101.       GetState:=(r.BP=1);
  102.     end;
  103.  
  104.   procedure SetMode(PercussionMode :integer);
  105.     {Percussion or Melodic Mode}
  106.     var
  107.       r :registers;
  108.     begin
  109.       r.SI:=6;
  110.       r.ES:=Seg(PercussionMode);
  111.       r.BX:=Ofs(PercussionMode);
  112.  
  113.       Intr(101,r);
  114.     end;
  115.  
  116.   function SetVolume(VolNum,VolDen,TimeNum,TimeDen :integer) :boolean;
  117.     var
  118.       TD,TN,VD,VN :word; {To put variables values in proper order in memory}
  119.       r           :registers;
  120.     begin
  121.       TD:=TimeDen;
  122.       TN:=TimeNum;
  123.       VD:=VolDen;
  124.       VN:=VolNum;
  125.  
  126.       r.SI:=8;
  127.       r.ES:=Seg(VN);
  128.       r.BX:=Ofs(VN);
  129.  
  130.       Intr(101,r);
  131.  
  132.       SetVolume:=(r.BP=1);
  133.     end;
  134.  
  135.   function SetTempo(Tempo,TimeNum,TimeDen :integer) :boolean;
  136.     var
  137.       TD,TN,TP :integer; {To put variables values in proper order in memory}
  138.       r        :registers;
  139.     begin
  140.       TD:=TimeDen;
  141.       TN:=TimeNum;
  142.       TP:=Tempo;
  143.  
  144.       r.SI:=9;
  145.       r.ES:=Seg(TP);
  146.       r.BX:=Ofs(TP);
  147.  
  148.       Intr(101,r);
  149.  
  150.       SetTempo:=(r.BP=1);
  151.     end;
  152.  
  153.   procedure SetActVoice(Voice :word);
  154.     var
  155.       r :registers;
  156.     begin
  157.       GActVoice:=Voice;
  158.  
  159.       r.SI:=12;
  160.       r.ES:=Seg(Voice);
  161.       r.BX:=Ofs(Voice);
  162.  
  163.       Intr(101,r);
  164.     end;
  165.  
  166.   function PlayNoteDel(Pitch :integer; LengthNum,LengthDen,DelayNum,DelayDen :word) :boolean;
  167.     var
  168.       DD,DN,LD,LN :word;
  169.       P           :integer;
  170.       r           :registers;
  171.     begin
  172.       P:=Pitch;
  173.       LD:=LengthDen;
  174.       LN:=LengthNum;
  175.       DN:=DelayNum;
  176.       DD:=DelayDen;
  177.  
  178.       r.SI:=14;
  179.       r.ES:=Seg(P);
  180.       r.BX:=Ofs(P);
  181.  
  182.       Intr(101,r);
  183.  
  184.       PlayNoteDel:=(r.BP=1);
  185.     end;
  186.  
  187.   function PlayNote(Pitch :integer; LengthNum,LengthDen :word) :boolean;
  188.     var
  189.       LD,LN :word;
  190.       P     :integer;
  191.       r     :registers;
  192.     begin
  193.       P:=Pitch;
  194.       LD:=LengthDen;
  195.       LN:=LengthNum;
  196.  
  197.       r.SI:=15;
  198.       r.ES:=Seg(P);
  199.       r.BX:=Ofs(P);
  200.  
  201.       Intr(101,r);
  202.  
  203.       PlayNote:=(r.BP=1);
  204.     end;
  205.  
  206.   function SetTimbre(TimeNum,TimeDen :word) :boolean;
  207.     var
  208.       TD,TN :word;
  209.       T     :^integer;
  210.       c1,c2 :byte;
  211.       r     :registers;
  212.     begin
  213.       T:=Addr(GT[GActVoice]);
  214.       TN:=TimeNum;
  215.       TD:=TimeDen;
  216.  
  217.       r.SI:=16;
  218.       r.ES:=Seg(T);
  219.       r.BX:=Ofs(T);
  220.  
  221.       Intr(101,r);
  222.  
  223.       SetTimbre:=(r.BP=1);
  224.     end;
  225.  
  226.   function SetPitch(DeltaOctave,DeltaNum,DeltaDen :integer; TimeNum,TimeDen :word) :boolean;
  227.     var
  228.       TD,TN   :word;
  229.       DD,DN,D :integer;
  230.       c1,c2   :byte;
  231.       r       :registers;
  232.     begin
  233.       D:=DeltaOctave;
  234.       DN:=DeltaNum;
  235.       DD:=DeltaDen;
  236.       TN:=TimeNum;
  237.       TD:=TimeDen;
  238.  
  239.       r.SI:=16;
  240.       r.ES:=Seg(D);
  241.       r.BX:=Ofs(D);
  242.  
  243.       Intr(101,r);
  244.  
  245.       SetPitch:=(r.BP=1);
  246.     end;
  247.  
  248.   procedure SetTickBeat(TickBeat :integer);
  249.     var
  250.       r :registers;
  251.     begin
  252.       r.SI:=18;
  253.       r.ES:=Seg(TickBeat);
  254.       r.BX:=Ofs(TickBeat);
  255.  
  256.       Intr(101,r);
  257.     end;
  258.  
  259.   procedure DirectNoteOn(Voice :word; Pitch :integer);
  260.     var
  261.       P :integer;
  262.       V :word;
  263.       r :registers;
  264.     begin
  265.       P:=Pitch;
  266.       V:=Voice;
  267.  
  268.       r.SI:=19;
  269.       r.ES:=Seg(V);
  270.       r.BX:=Ofs(V);
  271.  
  272.       Intr(101,r);
  273.     end;
  274.  
  275.   procedure DirectNoteOff(Voice :word);
  276.     var
  277.       r :registers;
  278.     begin
  279.       r.SI:=20;
  280.       r.ES:=Seg(Voice);
  281.       r.BX:=Ofs(Voice);
  282.  
  283.       Intr(101,r);
  284.     end;
  285.  
  286.   procedure DirectTimbre;
  287.     var
  288.       T     :^integer;
  289.       V     :word;
  290.       r     :registers;
  291.     begin
  292.       V:=GActVoice;
  293.       T:=Addr(GT[V]);
  294.  
  295.       r.SI:=21;
  296.       r.ES:=Seg(V);
  297.       r.BX:=Ofs(V);
  298.  
  299.       Intr(101,r);
  300.     end;
  301.  
  302.   procedure LoadInstrument(FileSpec :string);
  303.     {Load an Instument from Disk and Place in Array}
  304.     var
  305.       c1 :byte;
  306.       n  :integer;
  307.       f  :file of integer;
  308.     begin
  309.       if not(Exist(FileSpec)) then FileSpec:='C:\MUSIC\PIANO1.INS';
  310.       Assign(f,FileSpec);
  311.       Reset(f);
  312.       Read(f,n);
  313.       for c1:=1 to 26 do
  314.         Read(f,GT[GActVoice,c1]);
  315.       Close(f);
  316.     end;
  317.  
  318.   function LoadSong;
  319.     {Read a .ROL file and place song in Buffer}
  320.     var
  321.       nb :byte;
  322.       ns :string[255];
  323.       ni,ni2,ni3,ni4,BPM :integer;
  324.       c1,c2  :word;
  325.       nr,nr2 :real;
  326.       fl :boolean;
  327.       f  :file;
  328.     procedure StringRead(len :word); {uses f,ns}
  329.       var
  330.         nc :char;
  331.         c1 :word;
  332.       begin
  333.         ns:='';
  334.         for c1:=1 to len do
  335.           begin
  336.             BlockRead(f,nc,1);
  337.             ns:=ConCat(ns,nc);
  338.           end;
  339.       end;
  340.     procedure TempoRead; {uses f,nb}
  341.       var
  342.         b1,b2,b3,b4 :byte;
  343.       begin
  344.         BlockRead(f,b1,1);
  345.         BlockRead(f,b2,1);
  346.         BlockRead(f,b3,1);
  347.         BlockRead(f,b4,1);
  348.         nb:=(b3{ div 2});
  349.       end;
  350.     procedure VolumeRead;
  351.       var
  352.         b1,b2,b3,b4 :byte;
  353.       begin
  354.         BlockRead(f,b1,1);
  355.         BlockRead(f,b2,1);
  356.         BlockRead(f,b3,1);
  357.         BlockRead(f,b4,1);
  358.         nb:=51+Round(b3/2.5);
  359.       end;
  360.     begin
  361.       LoadSong:=true;
  362.       if not(Exist(FileSpec))
  363.         then begin
  364.                LoadSong:=false;
  365.                Exit;
  366.              end;
  367.  
  368.       InitDriver;
  369.       RelTimeStart(0,1);
  370.       Assign(f,FileSpec);
  371.       Reset(f,1);
  372.       StringRead(44);
  373.       BlockRead(f,ni,2); SetTickBeat(ni); {Ticks per Beat}
  374.       BlockRead(f,ni,2); BPM:=ni; {Beats per Measure}
  375.       StringRead(5);
  376.       BlockRead(f,nb,1); SetMode(1); {Mode}
  377.       StringRead(143);
  378.       TempoRead; fl:=SetTempo(nb,0,1); {Tempo}
  379.       BlockRead(f,ni,2);
  380.       for c1:=1 to ni do
  381.         begin
  382.           BlockRead(f,ni2,2);
  383.           TempoRead; fl:=SetTempo(nb,ni2,1); {Tempo}
  384.         end;
  385.       for c1:=0 to 10 do {11 Voices}
  386.         begin
  387.           SetActVoice(c1);
  388.           StringRead(15);
  389.           BlockRead(f,ni2,2); {Time in ticks of last Note}
  390.           c2:=0;
  391.           while (c2<ni2) do
  392.             begin
  393.               BlockRead(f,ni3,2); {Note Pitch}
  394.               BlockRead(f,ni4,2); {Note Duration}
  395.               fl:=PlayNote(ni3-60,ni4,BPM); {Note}
  396.               c2:=c2+ni4; {Summation of Durations}
  397.             end;
  398.           StringRead(15);
  399.           BlockRead(f,ni2,2);
  400.           for c2:=1 to ni2 do {Instuments}
  401.             begin
  402.               BlockRead(f,ni3,2);
  403.               StringRead(9);
  404.               nb:=Pos(#0,ns);
  405.               Delete(ns,nb,Length(ns));
  406.               LoadInstrument(ConCat('C:\MUSIC\',ns,'.INS'));
  407.               fl:=SetTimbre(ni3,1);
  408.               StringRead(1);
  409.               BlockRead(f,ni4,2);
  410.             end;
  411.           StringRead(15);
  412.           BlockRead(f,ni2,2);
  413.           nb:=1;
  414.           for c2:=1 to ni2 do {Volume}
  415.             begin
  416.               BlockRead(f,ni3,2);
  417.               fl:=SetVolume(100,nb,ni3,1); {Use inverse to disable Relative}
  418.               VolumeRead;
  419.               fl:=SetVolume(nb,100,ni3,1);
  420.             end;
  421.           StringRead(15);
  422.           BlockRead(f,ni2,2);
  423.           for c2:=1 to ni2 do {Pitch -disabled}
  424.             begin
  425.               BlockRead(f,ni3,2);
  426.               BlockRead(f,nr,4);
  427.               if (nr=0) then nr2:=1 else nr2:=nr;
  428. {             fl:=SetPitch(0,Abs(Trunc(nr*100)),Trunc((nr/nr2)*100),ni3,1);}
  429.             end;
  430.         end;
  431.       Close(f);
  432.     end;
  433.  
  434. end.